Developer CD Series 1992 June: ROMin Holiday/ADC Developer CD (1992-06) (''ROMin Holiday'')_iso/Developer Connection - 06-1992.iso/Developer Essentials/DTS Sample Code/System 7.0 Samples/ProcDoggie 1.0a6/ProcDoggie.p

Text File | 1991-02-07 | 17.8 KB | 583 lines | [TEXT/MPS ]

PROGRAM ProcDoggie;

{-------------------------------------------------------------------------------
#
#    Apple Macintosh Developer Technical Support
#
#    Main program file for the ProcDoggie application
#
#    Program:    ProcDoggie
#    File:        ProcDoggie.p - Pascal Implementation
#
#    by:        Forrest Tanaka
#
#    Copyright © 1988-1991 Apple Computer, Inc.
#    All rights reserved.
#
--------------------------------------------------------------------------------
#
#    ProcDoggie.p is the root file for ProcDoggie.  It contains the main entry
#    point and the PROGRAM statement, but relies on the other source files
#    included with this application to actually implement the functionality.
#
-------------------------------------------------------------------------------}
{[j=20/57/1$] Pasmat Options}
{$R-}


(*******************************************************************************
* Used Units
*******************************************************************************)

    USES
        (* Group 1 *)
         Types
        ,QuickDraw

        (* Group 2 *)
        ,AppleEvents
        ,Controls
        ,DiskInit
        ,Errors
        ,Events
        ,Fonts
        ,Memory
        ,Menus
        ,SegLoad

        (* Group 3 *)
        ,Processes
        ,Windows

        (* Group 4 *)
        ,Dialogs

        (* Application *)
        ,UGlobals
        ,UEmergMem
        ,UProcessUtils
        ,UMenuHandler
        ,UProcessGuts
        ;


(*******************************************************************************
* Constants
*******************************************************************************)

    CONST
        kBecomingActive = TRUE; {Pass to DoActivateEvt; indicates becoming active}


(*******************************************************************************
* Global Variables
*******************************************************************************)

    VAR
        gProcessListWind: WindowPtr; {Pointer to the process list window}


{$S Main}
(*******************************************************************************
* DoneRequiredParams - Done processing required params; OK?
*
* DoneRequiredParams checks to see if the AppleEvent specified by the
* anAppleEvent parameter has any required parameters that we haven’t yet
* processed.  If there aren’t any left, then noErr is returned.  If there are
* required parameters that haven’t been processed yet, then errAEEventNotHandled
* is returned.  If any other errors occur, then that error code is returned.
*******************************************************************************)

    FUNCTION DoneRequiredParams (anAppleEvent: AppleEvent): OSErr;

        VAR
            typeCode:   DescType; {Type of AppleEvent attribute found; ignored}
            actualSize: Size;     {Actual size of parameters; ignored}
            error:      OSErr;

    BEGIN
        (* Are there any required parameters in AppleEvent we didn’t process? *)
       error := AEGetAttributePtr (anAppleEvent, keyMissedKeywordAttr,
                typeWildCard, (*<*)typeCode, NIL, 0, (*<*)actualSize);
        IF error = errAEDescNotFound THEN
            (* No required parameters left, so no error *)
            DoneRequiredParams := noErr
        ELSE IF error = noErr THEN
            (* There was at least one required parameter we didn’t process *)
            DoneRequiredParams := errAEEventNotHandled
        ELSE
            (* Some other error happened *)
            DoneRequiredParams := error
    END;


{$S Main}
(*******************************************************************************
* HandleAEquit - Handler for 'quit' AppleEvent
*
* This is the AppleEvent handler for the 'quit' AppleEvent as passed in the
* quitAppleEvent parameter by the AppleEvent Manager.  The DoQuit routine is
* called which causes this application to quit at the start of the next
* iteration of the main event loop.
*
* Though the quit AppleEvent doesn’t contain any parameters, the standard thing
* to do in reaction to any AppleEvent is to check to see if there are any
* required parameters in the AppleEvent that this routine doesn’t recognise.
* DoneRequiredParms checks for this condition and returns an error if there are
* in fact required parameters in the AppleEvent or if some other error occurs
* during the check.
*******************************************************************************)

    FUNCTION HandleAEquit (quitAppleEvent: AppleEvent;
                           reply:          AppleEvent;
                           handlerRefCon:  LongInt): OSErr;

        VAR
            error: OSErr;

        PROCEDURE RecoverError (errorCode: OSErr);

        BEGIN
            HandleAEquit := errorCode;
            EXIT (HandleAEquit)
        END;

    BEGIN
        (* quit AE has no parms, but check in case the client requires any *)
        error := DoneRequiredParams (quitAppleEvent);
        IF error <> noErr THEN
            RecoverError (error);

        (* Handle the Quit command *)
        DoQuit;
        HandleAEquit := noErr
    END;


{$S %A5Init}
(*******************************************************************************
* StartUp - Do whatever has to be done to initialize the application
*
* This routine is called after the heap is initialized to initialize the
* application.  This involves initializing the toolbox, emergency memory, and
* loading up the menus.  If any errors occur while doing this, StartUp displays
* an alert telling the user what the error was and then ExitToShell is called.
* This is an unusual way to react to errors, and I only do it here because it’s
* so early in execution that there really isn’t much else that can be done.
*
* See this UEmergMem unit in this application for details about emergency
* memory.
*******************************************************************************)

    PROCEDURE StartUp;

        CONST
            kSysHandler = TRUE; {Specifies that AE handler is in system heap}

        VAR
            error: OSErr;

        PROCEDURE HandleError (messageClass: Integer;
                               messageIndex: Integer);

            VAR
                result: Integer; {Result of alert; ignored}

        BEGIN
            result := ShowStopAlert (messageClass, messageIndex);
            ExitToShell
        END;

    BEGIN
        (* Initialize the toolbox *)
        InitGraf (@thePort);
        InitFonts;
        InitWindows;
        InitMenus;
        TEInit;
        InitDialogs (NIL);

        (* Initialize emergency memory *)
        InitEmergMem;
        IF FailLowMemory (0) THEN
            HandleError (rMemErrMessages, kMemErrAppOpenMsg);

        (* Load the menus and draw the menu bar *)
        StartMenus;
        IF FailLowMemory (0) THEN
            HandleError (rMemErrMessages, kMemErrAppOpenMsg)
        ELSE IF gError <> noErr THEN
            IF gError = memFullErr THEN
                HandleError (rMemErrMessages, kMemErrAppOpenMsg)
            ELSE IF gError = resNotFound THEN
                HandleError (rResErrMessages, kResErrAppDamageMsg)
            ELSE
                HandleError (rMiscErrMessages, kMiscErrUnknownMsg);

        (* Install the AppleEvent handler *)
        error := AEInstallEventHandler (kCoreEventClass, kAEQuitApplication,
                @HandleAEquit, 0, NOT kSysHandler);
        IF (error = memFullErr) | FailLowMemory (0) THEN
            HandleError (rMemErrMessages, kMemErrAppOpenMsg)
        ELSE IF error <> noErr THEN
            HandleError (rMiscErrMessages, kMiscErrUnknownMsg)
    END;


{$S Main}
(*******************************************************************************
* Public: DoWindowDrag
*
* A rectangle that covers all screen can be retrieved from the desktop region’s
* rgnBBox.  The desktop region can be retrieved by calling GetGrayRgn.
*******************************************************************************)

    PROCEDURE DoWindowDrag (anEvent:       EventRecord;
                            clickedWindow: WindowPtr);

        VAR
            dragBounds: Rect; {Window can be dragged over this rectangle}

    BEGIN
        (* GetGrayRgn^^.rgnBBox covers the desktop over all screens *)
        dragBounds := GetGrayRgn^^.rgnBBox;
        DragWindow (clickedWindow, anEvent.where, dragBounds)
    END;


{$S Main}
(*******************************************************************************
* Public: DoContentClick
*
* As new kinds of windows are added to this application, this routine will have
* to be able to detect the new kind of window and dispatch to the routine that
* handles clicks in that kind of window.
*******************************************************************************)

    PROCEDURE DoContentClick (anEvent:       EventRecord;
                              clickedWindow: WindowPtr);

        VAR
            currWindow: WindowPtr; {Pointer to the current front window}

    BEGIN
        currWindow := FrontWindow;

        (* Clicked window not in front; activate it *)
        IF currWindow <> clickedWindow THEN
            SelectWindow (clickedWindow)
        ELSE
            IF IsProcessListWindow (clickedWindow) THEN
                ClickProcessListWindow (clickedWindow, anEvent)
    END;


{$S Main}
(*******************************************************************************
* Public: DoUpdateEvt
*
* As new kinds of windows are added to this application, this routine will have
* to be able to detect the new kind of window and dispatch to the routine that
* handles update events in that kind of window.
*******************************************************************************)

    PROCEDURE DoUpdateEvt (anEvent: EventRecord);

        VAR
            eventWindow: WindowPtr; {Pointer to the window to update}

    BEGIN
        eventWindow := WindowPtr(anEvent.message);

        (* Update the window that needs it *)
        SetPort (eventWindow);
        BeginUpdate (eventWindow);
        IF IsProcessListWindow (eventWindow) THEN
            DrawProcessListWindow (eventWindow)
        ELSE IF IsProcessInfoWindow (eventWindow) THEN
            DrawProcessInfoWindow (eventWindow);
        EndUpdate (eventWindow)
    END;


{$S Main}
(*******************************************************************************
* Public: DoActivateEvt
*
* As new kinds of windows are added to this application, this routine will have
* to be able to detect the new kind of window and dispatch to the routine that
* handles activate events in that kind of window.
*******************************************************************************)

    PROCEDURE DoActivateEvt (eventWind:      WindowPtr;
                             becomingActive: Boolean);

    BEGIN
        IF IsProcessListWindow (eventWind) THEN
            ActivateProcessListWindow (eventWind, becomingActive);
    END;


{$S Main}
(*******************************************************************************
* Public: DoWindowClose
*
* As new kinds of windows are added to this application, this routine will have
* to be able to detect the new kind of window and dispatch to the routine that
* handles close requests for that kind of window.
*******************************************************************************)

    PROCEDURE DoWindowClose (anEvent:   EventRecord;
                             eventWind: WindowPtr);

    BEGIN
        IF TrackGoAway (eventWind, anEvent.where) THEN
            IF IsProcessInfoWindow (eventWind) THEN
                CloseProcessInfoWindow (eventWind);
    END;


{$S Main}
(*******************************************************************************
* DoMouseDown - Mouse-down event dispatcher
*
* When a mouseDown event is received in the main event loop, this routine is
* called to determine which area on the screens the mouseDown was, and to
* dispatch to the appropriate routine to handle mouseDown events in that area.
* The mouseDown event is passed in the anEvent parameter.
*
* See the UMenuHandler unit for routines that handle mouse-down events in the
* menu bar, and the UWindowHandler unit for routines that handle mouse-down
* events in the windows.
*******************************************************************************)

    PROCEDURE DoMouseDown (anEvent: EventRecord);

        VAR
            clickArea: Integer;   {Area of the screen that was clicked}
            eventWind: WindowPtr; {Pointer the clicked window, if any}

    BEGIN
        (* Find clicked area of screen or window *)
        clickArea := FindWindow (anEvent.where, (*<*)eventWind);

        (* Jump to mouseDown-handling routine appropriate for screen area *)
        CASE clickArea OF
            inMenuBar:
                DoMenuChoice (MenuSelect (anEvent.where));
            inContent:
                DoContentClick (anEvent, eventWind);
            inGoAway:
                DoWindowClose (anEvent, eventWind);
            inDrag:
                DoWindowDrag (anEvent, eventWind)
        END
    END;


{$S Main}
(*******************************************************************************
* DoKeyDown - Key-down event dispatcher
*
* When a keyDown or autoKey event is received in the main event loop, this
* routine is called to determine whether key is a command-key equivalent for a
* menu item or not.  If the command key isn’t down, then the key stroke is
* ignored.  Otherwise, MenuKey is called to get the menu ID and item number
* of the menu item that corresponds to the command key, if any.  Then
* DoMenuChoice is called to dispatch to the appropriate routine for the chosen
* menu item.  The keyDown or autoKey event is passed in anEvent.
*
* See the UMenuHandler unit for routines that handle menu events.
*******************************************************************************)

    PROCEDURE DoKeyDown (anEvent: EventRecord);

        VAR
            theKey: Char; {ASCII code of key that was pressed}

    BEGIN
        (* Get the ASCII code of the pressed key *)
        theKey := CHR (BAND (anEvent.message, charCodeMask));

        (* If anEvent was keyDown and command key was down, it’s menu command *)
        IF (anEvent.what = keyDown) AND (BAND (anEvent.modifiers, cmdKey) <> 0)
                THEN
            DoMenuChoice (MenuKey (theKey))
    END;


{$S Main}
(*******************************************************************************
* DoDiskEvt - Handle a disk-insert event
*
* This routine is called whenever this application receives an event indicating
* that a disk was inserted.  If the disk can’t be mounted, the message field of
* the event reflects the error, and we call DIBadMount to allow the user to
* format the disk.
*******************************************************************************)

    PROCEDURE DoDiskEvt (anEvent: EventRecord);

        CONST
            kSysAlertLeft = 80; {Left coord of DIBadMount alert in screen coords}
            kSysAlertTop  = 80; {Top coord of DIBadMount alert in screen coords}

        VAR
            cornerPoint: Point; {Top-left corner of DIBadMount alert}
            error:       OSErr;

    BEGIN
        IF HiWrd (anEvent.message) <> noErr THEN
            BEGIN
                SetPt ((*<*)cornerPoint, kSysAlertLeft, kSysAlertTop);
                error := DIBadMount (cornerPoint, anEvent.message)
            END
    END;


{$S Main}
(*******************************************************************************
* Public: DoOSEvt
*
* When an OS Event is received, it can be a suspend or resume event.
*******************************************************************************)

    PROCEDURE DoOSEvt (anEvent: EventRecord);

        VAR
            eventWindow: WindowPtr; {Pointer to window being activated/deactivated}
            osEvtKind:   Byte;      {Kind of OSEvt; mouse-moved or suspend/resume}

    BEGIN
        (* Only care if anEvent is suspend/resume event *)
        osEvtKind := BAND (BSR (anEvent.message, 24), $00FF);
        IF osEvtKind = suspendResumeMessage THEN
            BEGIN
                (* It’s a suspend/resume event; suspend or resume? *)
                eventWindow := FrontWindow;
                IF BAND (anEvent.message, 1) <> 0 THEN
                    BEGIN
                        (* Resume event; set the cursor and activate front window *)
                        InitCursor;
                        IF eventWindow <> NIL THEN
                            DoActivateEvt (eventWindow, kBecomingActive);
                        gWereInFront := TRUE
                    END
                ELSE
                    BEGIN
                        (* Suspend event; deactivate the front window *)
                        IF eventWindow <> NIL THEN
                            DoActivateEvt (eventWindow, NOT kBecomingActive);
                        gWereInFront := FALSE
                    END
            END
    END;


{$S Main}
(*******************************************************************************
* DoHighLevelEvent - Handle a high-level event
*
* This routine handles the high-level event specified by anEvent.  The only
* high-level events that this application handles are AppleEvents, so I just
* pass the high-level event to AEProcessAppleEvent.  AEProcessAppleEvent calls
* the appropriate AppleEvent handler routine to handle that particular kind of
* AppleEvent.
*******************************************************************************)

    PROCEDURE DoHighLevelEvent (anEvent: EventRecord);

        VAR
            error: OSErr;

    BEGIN
        error := AEProcessAppleEvent (anEvent);
    END;


{$S Main}
(*******************************************************************************
* EventLoop - Main event loop for this application
*
* This is the main event loop of this application.  During every iteration of
* the event loop, the menus are kept up-to-date, and the Process List window and
* all of the open Process Information windows are given time to update
* themselves to current conditions.  Also, NoEmergMem is called to detect
* whether the emergency memory was used.  If it was, then RecoverEmergMem is
* called in an attept to get it back.  If it can’t, then some commands could be
* disabled until the memory can be recovered.
*******************************************************************************)

    PROCEDURE EventLoop;

        VAR
            anEvent: EventRecord; {An incoming event}

    BEGIN
        FixMenus;
        InitCursor;
        gWereInFront := WereInFront;
        gQuitting := FALSE;

        (* We loop “forever,” or until the Quit handler calls ExitToShell *)
        WHILE NOT gQuitting DO
            BEGIN
                (* Give all open windows some time *)
                IdleAllProcessWindows;

                (* Try to reallocate emergency memory if it’s been used *)
                IF NoEmergMem THEN
                    RecoverEmergMem;

                (* Fix the menus to reflect current conditions *)
                FixMenus;

                (* It’s time to get and examine an event *)
                IF WaitNextEvent (everyEvent, (*<*)anEvent, kMaxSleepTime, NIL) THEN
                    BEGIN
                        CASE anEvent.what OF
                            mouseDown:
                                DoMouseDown (anEvent);
                            keyDown, autoKey:
                                DoKeyDown (anEvent);
                            updateEvt:
                                DoUpdateEvt (anEvent);
                            diskEvt:
                                DoDiskEvt (anEvent);
                            activateEvt:
                                DoActivateEvt (WindowPtr(anEvent.message),
                                        BAND (anEvent.modifiers, activeFlag) <> 0);
                            osEvt:
                                DoOSEvt (anEvent);
                            kHighLevelEvent:
                                DoHighLevelEvent (anEvent)
                        END
                    END
            END
    END;


BEGIN
    (* Set up the heap *)
    MaxApplZone;
    MoreMasters;
    MoreMasters;
    MoreMasters;
    MoreMasters;
    MoreMasters;
    MoreMasters;

    (* Do anything that must be done at program start-up *)
    StartUp;
    UnloadSeg (@StartUp);

    (* Set the default launch mode *)
    SetLaunchMode (kJustLaunch);

    (* Open the process list window *)
    gProcessListWind := CreateProcessListWindow;

    (* Enter the main event loop *)
    EventLoop
END.